unit DM_API_Server_Sockets;

interface

uses
  Classes,
  OverbyteIcsWSocket, OverbyteIcsWSocketS;

type
  TSendThread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  end;

const
 tknClient = 'client';
 tknAnswer = 'answer';

function SocketServerStart(evtOnClientConnect: TWSocketClientConnectEvent): Boolean;
procedure SocketServerFree;
function SocketServerClients: Integer;

procedure SendThreadStart;
procedure SendThreadResume;
procedure SendThreadFree;

procedure AddToSendQueue(const Client, Msg: String; ID: String = '');

function ClientIndex(WSS: TWSocketServer; Client: TWSocketClient): Integer;

implementation

uses
 Windows,
 SysUtils,
 Tokens,
 DM_API_Server_Defines,
 DM_API_Server_Tokens;

var
 CS_SndQ: TRTLCriticalSection;
 SendQueue: TStrings = nil;
 SendThread: TSendThread = nil;
 WSServer: TWSocketServer = nil;

{ Common stuff }

function ClientIndex(WSS: TWSocketServer; Client: TWSocketClient): Integer;
begin
 if Assigned(WSS) and Assigned(Client) then
  begin
   Result:=WSS.ClientCount-1;
   while (WSS.Client[Result]<>Client) and (Result>=0) do
     Dec(Result);
  end
 else
   Result:=-1;
end;

procedure SendQueueCSCreate;
begin
 InitializeCriticalSection(CS_SndQ);
end;

procedure SendQueueCSFree;
begin
 DeleteCriticalSection(CS_SndQ);
end;

procedure SendQueueFree;
begin
 if Assigned(SendQueue) then
   FreeAndNil(SendQueue);
end;

procedure SendThreadStart;
begin
 SendThreadFree;
 SendQueueCSCreate;
 SendQueue:=TStringList.Create;
 SendThread:=TSendThread.Create(true);
 SendThread.Priority:=tpLower;
end;

procedure SendThreadResume;
begin
 if Assigned(SendThread) then
  begin
   if SendThread.Suspended then
     SendThread.Resume;
  end;
end;

procedure SendThreadFree;
begin
 if Assigned(SendThread) then
  begin
   SendThread.Terminate;
   if not SendThread.Suspended then
     SendThread.WaitFor;
   FreeAndNil(SendThread);
  end;
 SendQueueFree;
 SendQueueCSFree;
end;

procedure AddToSendQueue(const Client, Msg: String; ID: String = '');
begin
 //MessageBox(0, PChar('Adding '+Msg+' ...'), 'Sender', MB_OK or MB_ICONWARNING); //debug
 if Assigned(SendQueue) then
  begin
   EnterCriticalSection(CS_SndQ);
   SendQueue.Add(EncodeToken(tknClient, Client)+EncodeToken(tknAnswer, Msg)+EncodeToken(tknID, ID));
   LeaveCriticalSection(CS_SndQ);
  end;
 //MessageBox(0, 'Done.', 'Sender', MB_OK or MB_ICONWARNING); //debug
end;

function SocketServerStart(evtOnClientConnect: TWSocketClientConnectEvent): Boolean;
begin
 if Assigned(WSServer) then
   SocketServerFree;
 Result:=true;
 WSServer := TWSocketServer.Create(nil);
 WSServer.OnClientConnect := evtOnClientConnect;
 WSServer.Banner          := ''; //tknBanner;
 WSServer.Proto           := 'tcp';         { Use TCP protocol  }
 WSServer.LineMode:=true;
 WSServer.LineEdit:=false;
 WSServer.Addr:='127.0.0.1';
 WSServer.Port:=IntToStr(mySettings.Port);
 WSServer.ClientClass     := TWSocketClient;{ Use our component }
 try
  WSServer.Listen;                           { Start listening    }
 except
  FreeAndNil(WSServer);
  Result:=false;
 end;
end;

procedure SocketServerFree;
begin
 if Assigned(WSServer) then
  begin
   WSServer.DisconnectAll;
   FreeAndNil(WSServer);
  end;
end;

function SocketServerClients: Integer;
begin
 if Assigned(WSServer) then
   Result:=WSServer.ClientCount
 else
   Result:=-1;
end;

{ TSendThread }

procedure TSendThread.Execute;
 var
  i: Integer;
  Cmd, Cli, Txt: String;
begin
 while not Terminated do
  begin
   if Assigned(SendQueue) then
    begin
     EnterCriticalSection(CS_SndQ);
     if SendQueue.Count>0 then
      begin
       //FIFO
       Cmd:=SendQueue[0];
       SendQueue.Delete(0);
       LeaveCriticalSection(CS_SndQ);
       //get message text
       //MessageBox(0, PChar('['+Cmd+']'), 'Sender', MB_OK or MB_ICONWARNING); //debug
       Txt:=ExtractToken(tknAnswer, Cmd);
       //send from available server
       if Assigned(WSServer) and (Txt<>'') then
        begin
         Cli:=ExtractToken(tknClient, Cmd);
         i:=StrToIntDef(Cli, -1);
         if i<0 then
          begin
           //multicast
           for i:=0 to WSServer.ClientCount-1 do
             (WSServer.Client[i] as TWSocketClient).SendStr(Txt+CRLF);
          end
         else
          begin
           //single client answer
           if (i<WSServer.ClientCount) then
            begin
             //MessageBox(0, PChar('['+Txt+']'), 'Sender', MB_OK or MB_ICONWARNING); //debug
             (WSServer.Client[i] as TWSocketClient).SendStr(EncodeToken(tknData, Txt)+CopyToken(tknID, Cmd)+CRLF);
            end;
          end;
        end;
       Sleep(50); //small pause to have a rest ;)
      end
     else
      begin
       LeaveCriticalSection(CS_SndQ);
       Sleep(50);
       Suspend; //no items in queue
      end;
    end
   else
     Suspend; //no queue
  end;
end;

end.
